# loading libraries
library(tidyverse)
library(leaflet)
library(sf)

Import data

# import csv data on cities with TED talks to later combine with shapefile
ted_raw <- readxl::read_excel("../raw_data/ted.xlsx") %>%
  mutate(city = str_replace(city, "durham, nc", "durham"))

# narrow down TED data to Americas and Asia, and use that to build countries sf (sf for animation, not leaflet)
sf_cities_aa <- ted_raw %>%
  filter(macro_region %in% c("Americas", "Asia")) %>%
  mutate(country = str_to_title(country),
         city = str_to_title(city)) %>%
  st_as_sf(coords = c("lon", "lat"), remove = F, crs = 4326, agr = "constant") %>%
  group_by(year, city, lat) %>%
  mutate(yearly_count = n()) %>%
  ungroup() %>%
  select(3:7, 16:18) %>%
  unique()

Import shapefile of all countries: File came from the State Department and I used Mapshaper to reduce the file size using the Simplify option

sf_world <- read_sf("../raw_data/Department of State Large-Scale International Boundary (LSIB)/Department of State Large-Scale International Boundary (LSIB).shp") %>%
  mutate(Name = str_to_title(Name)) %>%
  mutate(Name = str_squish(Name))

Create countries sf from TED cities data + world sf

# To create the choropleth country map for the Americas and Asia: convert sf back to csv (and further below back to sf) of just countries from cities_aa that include the total number of talks by country (2009-2018)
sf_countries_aa <- sf_cities_aa %>%
  tbl_df() %>%
  select(country, year) %>% 
  group_by(year, country) %>%
  mutate(total_yrly = n()) %>%
  ungroup() %>%
  unique() %>%
  mutate(country = str_squish(country)) %>%
  group_by(country) %>%
  mutate(total = sum(total_yrly)) %>%
  ungroup()

# Now need spatial geometry for each country in Americas and Asia from sf_world. Only using countries in narrowed-down sf_countries_aa df so need to make sure country names match in both. If not, change the name in sf_world. See what's in sf_countries_aa that's not in sf_world.
setdiff(sf_countries_aa$country, sf_world$Name)
##  [1] "Myanmar (Burma)"        "Hong Kong"              "Aruba"                 
##  [4] "Trinidad And Tobago"    "Puerto Rico"            "Bermuda"               
##  [7] "Curaã§Ao"               "Macao"                  "Cayman Islands"        
## [10] "Maldives"               "British Virgin Islands" "Saint Kitts And Nevis" 
## [13] "Antigua And Barbuda"    "Greenland"
#  [1] "Myanmar (Burma)"        "Hong Kong"             
#  [3] "Aruba"                  "Trinidad And Tobago"   
#  [5] "Puerto Rico"            "Bermuda"               
#  [7] "Curaã§Ao"               "Macao"                 
#  [9] "Cayman Islands"         "Maldives"              
# [11] "British Virgin Islands" "Saint Kitts And Nevis" 
# [13] "Antigua And Barbuda"    "Greenland"  

# Fix spelling: Rename Curaã§Ao to Curaçao in sf_countries_aa, and reformat others
sf_countries_aa <- sf_countries_aa %>%
  mutate(country = str_replace(country, "Trinidad And Tobago", "Trinidad and Tobago")) %>% # old, new
  mutate(country = str_replace(country, "Curaã§Ao", "Curaçao")) %>% 
  mutate(country = str_replace(country, "Saint Kitts And Nevis", "Saint Kitts and Nevis")) %>%
  mutate(country = str_replace(country, "Antigua And Barbuda", "Antigua and Barbuda"))
# Check for new and old value
subset(sf_countries_aa, grepl("Curaçao", country)) # yes, 3 rows
## # A tibble: 3 x 4
##   country year  total_yrly total
##   <chr>   <chr>      <int> <int>
## 1 Curaçao 2015           1     4
## 2 Curaçao 2018           1     4
## 3 Curaçao 2016           2     4
subset(sf_countries_aa, grepl("Curaã§Ao", country)) # none, good
## # A tibble: 0 x 4
## # … with 4 variables: country <chr>, year <chr>, total_yrly <int>, total <int>
# Rename values in sf_world to match what's in sf_countries_aa (will have to manually look it up using View() and then right_join() with sf_countries_aa to make the latter a sf and eliminate geometries from sf_world to only what's in sf_countries_aa
sf_countries_aa <- sf_world %>%
  mutate(Name = str_replace_all(Name, c("Burma" = "Myanmar \\(Burma\\)", # old (sf_world) = new (i.e. what's in sf_countries_aa), 2 countries not in sf
                                          "Hong Kong \\(China\\)" = "Hong Kong",
                                          "Aruba \\(Neth\\)" = "Aruba",
                                          "Trinidad & Tobago" = "Trinidad and Tobago",
                                          "Puerto Rico \\(Us\\)" = "Puerto Rico",
                                          "Bermuda \\(Uk\\)" = "Bermuda",
                                          "Macau \\(China\\)" = "Macao",
                                          "Cayman Islands \\(Uk\\)" = "Cayman Islands",
                                          "Virgin Islands \\(Uk\\)" = "British Virgin Islands",
                                          "Saint Kitts & Nevis" = "Saint Kitts and Nevis",
                                          "Antigua & Barbuda" = "Antigua and Barbuda",
                                          "Greenland \\(Denmark\\)" = "Greenland"))) %>%
  right_join(sf_countries_aa, by=c("Name"="country"))

# spread yearly country count for tooltip, include yearly count + total count for each country
sf_countries_aa_wide <- sf_countries_aa %>%
  select(1:4, total, everything()) %>%
  spread(year, total_yrly) %>%
  mutate_all(~replace(., is.na(.), 0)) 
# make cities_aa suitable for leaflet mapping by adding yearly totals for tooltips
sf_cities_aa_wide <- sf_cities_aa %>%
  tbl_df() %>%
  group_by(city, country, lat) %>% # nyc has multiple lat/lon so need to differentiate for counts
  mutate(city_total = sum(yearly_count)) %>%
  ungroup() %>%
  select(country, city, lat, lon, city_total, year, yearly_count) %>%
  spread(year, yearly_count) %>%
  mutate_all(~replace(., is.na(.), 0))

Leaflet

Prep

country_bins <- c(0, 1, 100, 250, 500, 4000)
country_pal <- colorBin("Reds", domain = sf_countries_aa_wide$total, bins = country_bins)

# country tooltip
country_label <- sprintf(
  "<span style='font-size:1.2em; color:#E62B1E;'><b>%s</b></span>
  <br /><b>Total Talks</b>: %g 
  <hr style='background-color:#E62B1E; height: 1px; border:none'>
  <b>2009</b>: %g
  <br /><b>2010</b>: %g
  <br /><b>2011</b>: %g
  <br /><b>2012</b>: %g
  <br /><b>2013</b>: %g
  <br /><b>2014</b>: %g
  <br /><b>2015</b>: %g
  <br /><b>2016</b>: %g
  <br /><b>2017</b>: %g
  <br /><b>2018</b>: %g",
  sf_countries_aa_wide$Name,
  sf_countries_aa_wide$total,
  sf_countries_aa_wide$`2009`,
  sf_countries_aa_wide$`2010`,
  sf_countries_aa_wide$`2011`,
  sf_countries_aa_wide$`2012`,
  sf_countries_aa_wide$`2013`,
  sf_countries_aa_wide$`2014`,
  sf_countries_aa_wide$`2015`,
  sf_countries_aa_wide$`2016`,
  sf_countries_aa_wide$`2017`,
  sf_countries_aa_wide$`2018`
) %>% lapply(htmltools::HTML)
# label format
country_label_style <- labelOptions( # tooltip format
  style = list("font-weight" = "normal", "font-family" = "Helvetica", padding = "4px 8px"),
  textsize = "14px",
  direction = "auto")

# city tooltip
city_label <- sprintf(
  "<span style='font-size:1.2em; color:#E62B1E;'><b>%s, %s</b></span>
  <br /><b>Total Talks</b>: %g 
  <hr style='background-color:#E62B1E; height: 1px; border:none'>
  <b>2009</b>: %g
  <br /><b>2010</b>: %g
  <br /><b>2011</b>: %g
  <br /><b>2012</b>: %g
  <br /><b>2013</b>: %g
  <br /><b>2014</b>: %g
  <br /><b>2015</b>: %g
  <br /><b>2016</b>: %g
  <br /><b>2017</b>: %g
  <br /><b>2018</b>: %g",
  sf_cities_aa_wide$city,
  sf_cities_aa_wide$country,
  sf_cities_aa_wide$city_total,
  sf_cities_aa_wide$`2009`,
  sf_cities_aa_wide$`2010`,
  sf_cities_aa_wide$`2011`,
  sf_cities_aa_wide$`2012`,
  sf_cities_aa_wide$`2013`,
  sf_cities_aa_wide$`2014`,
  sf_cities_aa_wide$`2015`,
  sf_cities_aa_wide$`2016`,
  sf_cities_aa_wide$`2017`,
  sf_cities_aa_wide$`2018`
) %>% lapply(htmltools::HTML)

# chart on popup: 
# https://stackoverflow.com/questions/32352539/plotting-barchart-in-popup-using-leaflet-library
# https://stackoverflow.com/questions/58606560/r-leaflet-popupgraph-addpopupgraphs-on-map-marker-click
# https://github.com/r-spatial/leafpop

Function to generate line chart when clicking a country

# function to generate line chart for each country
# https://stackoverflow.com/questions/58606560/r-leaflet-popupgraph-addpopupgraphs-on-map-marker-click
country_line <- function(x) {
  sf_countries_aa_wide %>%
    filter(Name == x) %>%
    gather(years, total_yrly, `2009`:`2018`) %>%
    ggplot() +
      geom_line(aes(years, total_yrly), group=1, color="#E62B1E") +
      theme_minimal() +
      theme(plot.title = element_text(size = rel(2), family="Helvetica", face="bold", color="#E62B1E"),
            axis.title.y = element_text(family="Helvetica", color="#E62B1E")) +
      labs(
        x = "", 
        y = "TED Talks",
        title = x)
}
line_popup <- lapply(sf_countries_aa_wide$Name, country_line)

Interactive map

Line graph does not appear properly when clicking on a country.

leaflet() %>%
    #setView(-85.6024, 12.7690, zoom = 2) %>%
  setView(0,0, zoom = 2) %>%
    #addProviderTiles("Esri.WorldTerrain") %>%
    addProviderTiles("CartoDB.DarkMatterNoLabels") %>%
    addPolygons(data=sf_countries_aa_wide,
                weight=1,
                color = "black",
                fillColor = ~country_pal(total),
                fillOpacity=1,
                label = country_label,
                labelOptions = country_label_style,
                group = "Countries"
                ) %>%
  leafpop::addPopupGraphs(line_popup, group = "Countries") %>%
  addCircleMarkers(data = sf_cities_aa_wide,
                   ~as.numeric(lon), ~as.numeric(lat),
                   stroke = F,
                   radius = ~sqrt(city_total),
                   fillColor = "black",
                   label = city_label,
                   labelOptions=country_label_style,
                   group = "Cities",
                   fillOpacity = 0.5) %>%
  addLayersControl( # https://rstudio.github.io/leaflet/showhide.html
    overlayGroups = "Cities",
    options = layersControlOptions(collapsed = F)
  )

Animated map

Code only

# gganimate: 
# https://stackoverflow.com/questions/57734180/cumulative-points-over-year-on-map-with-r-ggplot2-and-ggplotly
# https://www.aliesdataspace.com/2019/05/animation-station/
# https://stackoverflow.com/questions/49155038/how-to-save-frames-of-gif-created-using-gganimate-package

library(gganimate)
library(gifski)

# to manually set dimensions of animated map
options(gganimate.dev_args = list(width = 12, height = 5.5, units = 'in', res=300))

anime <- ggplot() +
  geom_sf(data=sf_world, fill="black", color="white", size=0.25) +
  geom_sf(data=sf_cities_aa, size=2, alpha=0.4, stroke = 0, color="#E62B1E", show.legend=F) +
  theme_void() +
  coord_sf(crs=st_crs(sf_countries_aa), 
           #xlim = c(-180, -10), 
           ) +
  gganimate::transition_states(sf_cities_aa$year, transition_length = 0, state_length = 1) +
  labs(title = "{closest_state}") +
  theme(plot.title = element_text(size = rel(2), color="#E62B1E"),
        text = element_text(family="Helvetica", face="bold")) +
  gganimate::shadow_mark()
  #gganimate::anim_save("output_data/ted_map.gif", renderer = gifski_renderer())

# if last line of anim_save() doesn't work, comment it out, save ggplot() as anime (or whatever), run line below, then if you run above (with anim_save()) it might work
#animate(anime, renderer = gifski_renderer("output_data/ted_map.gif"))